home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / colors.tcl < prev    next >
Text File  |  1996-01-07  |  8KB  |  394 lines
  1. #===============================================================================
  2. # Color menu and support routines
  3. #
  4. set colorMenu "Ñ137"
  5.  
  6. menu -n $colorMenu -p colorMenuProc {
  7.     {menu -n Color -p colorMenuProc {
  8.         foreground
  9.         blue
  10.         cyan
  11.         green
  12.         magenta
  13.         red
  14.         white
  15.         yellow
  16.         "(-"
  17.         color_9
  18.         color_10
  19.         color_11
  20.         color_12
  21.         color_13
  22.         color_14
  23.         color_15
  24.     }}
  25.  
  26.     {menu -n Style -p colorMenuProc {
  27.         "/B<U<Obold"
  28.         condense
  29.         extend
  30.         italic
  31.         normal
  32.         outline
  33.         shadow
  34.         "/U<U<Ounderline"
  35.     }}
  36.     "(-"
  37.     "/f<SredWord"
  38.     "/f<S<IredMark"
  39.     "/g<SblueWord"
  40.     "/g<S<IblueMark"
  41.     "/h<SgreenWord"
  42.     "/h<S<IgreenMark"
  43.     "underlineWord"
  44.     "(-"
  45.     "/H<UhyperText"
  46.     "urlLink"
  47.     "mailtoLink"
  48.     "/jlinkToFile"
  49.     "/k<SlinkToMark"
  50.     "/k<S<IlinkToFile&Mark"
  51.     "(-"
  52.     "listColors"
  53.     "removeColors"
  54. }
  55.     
  56. insertMenu $colorMenu
  57.  
  58. proc redWord {} { colorSelect 5 0 ; centerRedraw }
  59.  
  60. proc blueWord {} { colorSelect 1 0 ; centerRedraw }
  61.  
  62. proc greenWord {} { colorSelect 3 0 ; centerRedraw }
  63.  
  64. proc redMark {} {
  65.     colorSelect 5 0
  66.     setNamedMark
  67.     centerRedraw
  68. }
  69. proc blueMark {} {
  70.     colorSelect 1 0
  71.     setNamedMark
  72.     centerRedraw
  73. }
  74. proc greenMark {} {
  75.     colorSelect 3 0
  76.     setNamedMark
  77.     centerRedraw
  78. }
  79.  
  80. proc underlineWord {} {
  81.     insertColorEscape [getPos] 15
  82.     insertColorEscape [selEnd] 12
  83.     centerRedraw
  84. }
  85.  
  86. proc colorMenuProc {menu item} {
  87.  
  88.     switch $item {
  89.         black   {colorSelect $item 0}
  90.         blue    {colorSelect $item 0}
  91.         cyan    {colorSelect $item 0}
  92.         green   {colorSelect $item 0}
  93.         magenta {colorSelect $item 0}
  94.         red     {colorSelect $item 0}
  95.         white   {colorSelect $item 0}
  96.         yellow  {colorSelect $item 0}
  97.     
  98.         bold      {colorSelect  $item 12}
  99.         condense  {colorSelect  $item 12}
  100.         extend    {colorSelect $item 12}
  101.         italic    {colorSelect $item 12}
  102.         normal    {colorSelect $item 12}
  103.         outline   {colorSelect $item 12}
  104.         shadow    {colorSelect $item 12}
  105.         underline {colorSelect $item 12}    
  106.  
  107.         hyperText     {markAsHyper}
  108.         listColors    {listColorEscapes}
  109.         removeColors  {removeColorEscapes}
  110.         
  111.         default {eval $item}
  112.     }
  113. }
  114.  
  115. proc listColorEscapes {} {
  116.     set colors [getColors]
  117.     
  118.     set res "    Pos  Code  Hypertext\n"
  119.     foreach item $colors {
  120.         set off [lindex $item 0]
  121.         set code [lindex $item 1]
  122.         set cmd [lreplace $item 0 1]
  123.         if {[string length $cmd]>1} {
  124.             append res [format "%7d  %3d  %s\n" $off $code $cmd]
  125.         } else {
  126.             append res [format "%7d  %3d\n" $off $code]
  127.         }
  128.     }
  129.     
  130.     if {[llength $colors]>0} {        
  131.         new -n "* Color Codes *"
  132.         insertText $res
  133.         goto 0
  134.         catch {shrinkWindow 2}
  135.         set win [lindex [winNames -f] 0]
  136.         setWinInfo -w $win dirty 0
  137.         setWinInfo -w $win read-only 1
  138.     
  139.     } else {
  140.         message "No color codes found"
  141.     }
  142. }
  143.     
  144.  
  145. #===============================================================================
  146.  
  147. set lastHyper {} 
  148.  
  149. proc markAsHyper {} {
  150.     global lastHyper
  151.     
  152.     set from [getPos]
  153.     set to [selEnd]
  154.     if {$from == $to} {
  155.         beep
  156.         return
  157.     }
  158.     set lastHyper [prompt "Hyper-text?" $lastHyper]
  159.     insertColorEscape $from 3
  160.     insertColorEscape $from 15 $lastHyper
  161.     insertColorEscape $to 12
  162.     insertColorEscape $to 0
  163.     centerRedraw
  164. }
  165.  
  166. proc colorSelect {ind ind2} {
  167.     set from [getPos]
  168.     set to [selEnd]
  169.     
  170.     insertColorEscape $from $ind
  171.     insertColorEscape $to $ind2
  172. }
  173.  
  174.  
  175. proc linkToFile {{path {}} {from {}} {to {}}} {    
  176.     global HOME
  177.     if {$from == {}} { set from [getPos] }
  178.     if {$to == {}} { set to [selEnd] }
  179.     if {$from == $to} {
  180.         beep
  181.         return
  182.     }
  183.  
  184.     if {$path == {}} {
  185.         set path [getfile "Choose target of hyperlink:"]
  186.         # make path relative to Alpha's home folder
  187.         set qHome [quoteExpr $HOME]
  188.         regsub "$qHome" $path {$HOME} path
  189.     }
  190.  
  191.     set cmd "edit \"$path\""
  192.     insertColorEscape $from 3
  193.     insertColorEscape $from 15 $cmd
  194.     insertColorEscape $to 12
  195.     insertColorEscape $to 0
  196.     centerRedraw
  197. }
  198.  
  199. proc linkToMark {{mark {}} {from {}} {to {}}} {    
  200.     if {$from == {}} { set from [getPos] }
  201.     if {$to == {}} { set to [selEnd] }
  202.     if {$from == $to} {
  203.         beep
  204.         return
  205.     }
  206.     
  207.     set mark [listpick -p "Choose a Mark:" -L [list $mark] [getNamedMarks -n]]
  208.  
  209.     set cmd "gotoMark \"$mark\""
  210.     insertColorEscape $from 3
  211.     insertColorEscape $from 15 $cmd
  212.     insertColorEscape $to 12
  213.     insertColorEscape $to 0
  214.     centerRedraw
  215. }
  216.  
  217. proc urlLink {{from {}} {to {}}} {    
  218.     if {$from == {}} { set from [getPos] }
  219.     if {$to == {}} { set to [selEnd] }
  220.     if {$from == $to} {
  221.         beep
  222.         return
  223.     }
  224.  
  225.     set text [getText $from $to]
  226.  
  227.     set cmd "sendUrl \"$text\""
  228.     insertColorEscape $from 3
  229.     insertColorEscape $from 15 $cmd
  230.     insertColorEscape $to 12
  231.     insertColorEscape $to 0
  232.     centerRedraw
  233. }
  234.  
  235. proc mailtoLink {{from {}} {to {}}} {    
  236.     if {$from == {}} { set from [getPos] }
  237.     if {$to == {}} { set to [selEnd] }
  238.     if {$from == $to} {
  239.         beep
  240.         return
  241.     }
  242.  
  243.     set text [getText $from $to]
  244.  
  245.     set cmd "sendUrl \"mailto:$text\""
  246.     insertColorEscape $from 3
  247.     insertColorEscape $from 15 $cmd
  248.     insertColorEscape $to 12
  249.     insertColorEscape $to 0
  250.     centerRedraw
  251. }
  252.  
  253. proc linkToFile&Mark {{path {}} {mark {}} {from {}} {to {}}} {
  254.     global HOME
  255.     if {$from == {}} { set from [getPos] }
  256.     if {$to == {}} { set to [selEnd] }
  257.     if {$from == $to} {
  258.         beep
  259.         return
  260.     }
  261.     
  262.     if {$path == {}} {
  263.         set path [getfile "Choose a file:"]
  264.         # make path relative to Alpha's home folder
  265.         set qHome [quoteExpr $HOME]
  266.         regsub "$qHome" $path {$HOME} path
  267.     }
  268.     
  269.     set current [lindex [winNames -f] 0]
  270.     
  271.     if {![catch {openFileQuietly $path}]} {
  272.         
  273.         set mark [listpick -p "Choose a mark in that file:" -L [list $mark] [getNamedMarks -n -w $path]]
  274.         
  275.         bringToFront $current
  276.         
  277.         set cmd "edit \"$path\" ; gotoMark \"$mark\""
  278.         insertColorEscape $from 3
  279.         insertColorEscape $from 15 $cmd
  280.         insertColorEscape $to 12
  281.         insertColorEscape $to 0
  282.         centerRedraw
  283.     }
  284. }
  285.  
  286. proc colorDummy {} {}
  287.  
  288. #===============================================================================
  289. # Pete's manual-marking routines
  290.  
  291. proc markManual {} {
  292.     set pos 0
  293.     while {[string length [set inds [search -f 1 -r 1 {^          } $pos]]]} {
  294.         set pos1 [lindex $inds 1]
  295.         set label [getText $pos1 [expr [nextLineStart $pos1] - 1]]
  296.         set pos2 [lineStart $pos1]
  297.         setNamedMark $label $pos2 $pos2 $pos2
  298.         set pos [expr [nextLineStart $pos1]]
  299.     }
  300. }
  301.  
  302. proc colorManualMarks {} {
  303.     goto 0
  304.     hiliteWord
  305.     endLineSelect
  306.     set from [getPos]
  307.     set to [selEnd]
  308.     insertColorEscape $from 5
  309.     insertColorEscape $from 15
  310.     insertColorEscape $to 12
  311.     insertColorEscape $to 0
  312.  
  313.     foreach mk [getNamedMarks] {
  314.         set name [lindex $mk 0]
  315.         set disp [lindex $mk 2]
  316.         set pos [lindex $mk 3]
  317.         set end [lindex $mk 4]
  318.         
  319.         goto $disp
  320.         hiliteWord
  321.         endLineSelect
  322.         set from [getPos]
  323.         set to [selEnd]
  324.         
  325.         insertColorEscape $from 5
  326.         insertColorEscape $from 15
  327.         insertColorEscape $to 12
  328.         insertColorEscape $to 0
  329.     }
  330. }
  331.  
  332. #===============================================================================
  333.  
  334. proc markAlphaCommands {} {
  335.     set pos 0
  336.     while {[string length [set inds [search -f 1 -r 1 {^Ñ } $pos]]]} {
  337.         set pos1 [lindex $inds 1]
  338.         goto $pos1
  339.         hiliteWord
  340.         set label [getSelect]
  341.         set from [getPos]
  342.         set to [selEnd]
  343.         setNamedMark $label $pos1 $from $to
  344.         insertColorEscape $from 1
  345.         insertColorEscape $to 0
  346.         set pos [expr [nextLineStart $pos1]]
  347.     }
  348. }
  349.  
  350. #===============================================================================
  351.  
  352. proc markChanges {} {
  353.     set pos 0
  354.     while {[string length [set inds [search -f 1 -r 1 {^= } $pos]]]} {
  355.         set pos1 [lindex $inds 1]
  356.         goto $pos1
  357.         endLineSelect
  358.         redWord
  359.         set pos [expr [nextLineStart $pos1]]
  360.     }
  361. }
  362.  
  363. #===============================================================================
  364.  
  365.  
  366. proc listNamedMarks {} {
  367.  
  368.     set nm [lindex [winNames -f] 0]
  369.     
  370.     set res "    Pos    Disp     End  Name\n"
  371.     append res "------- ------- -------  --------------------\n"
  372.     foreach mk [getNamedMarks] {
  373.         set name [lindex $mk 0]
  374.         set disp [lindex $mk 2]
  375.         set pos [lindex $mk 3]
  376.         set end [lindex $mk 4]
  377.         append res [format "%7d %7d %7d  %s\n" $pos $disp $end $name]
  378.     }
  379.     
  380.     if {[llength [getNamedMarks]]>0} {        
  381.         new -n "* Named Marks *"
  382.         insertText $res
  383.         goto 0
  384.         catch {shrinkWindow 2}
  385.         set win [lindex [winNames -f] 0]
  386.         setWinInfo -w $win dirty 0
  387.         setWinInfo -w $win read-only 1
  388.     
  389.     } else {
  390.         message "No color codes found"
  391.     }
  392. }
  393.  
  394.